#! perl -w

package S3QL::Raw;
$S3QL::Raw::VERSION = '1.0';

use warnings;
use Carp;
use Exporter;

=head1 NAME

S3QL::Raw - Low-level interface to the S3DB API

=head1 SYNOPSIS

 require S3QL::Raw;
 $raw = new S3QL::Raw({my_key => $key});
 $raw = new RawS3GL({my_key => $key, my_host => $host});
 $q = $raw->select($stuff) . $raw->from($table);
 $criteria = '';
 foreach my $k (keys %$where) {
    $criteria .= $raw->$k($where->{$k});
 }
 $q .= $raw->where($criteria);

=head1 DESCRIPTION

The S3QL::Raw class represents a low-level interface to the S3DB API,
which is documented at L<http://www.s3db.org>.  The query language
(S3QL) relies on HTTP GET requests to a server linked to an S3DB
database. The basic format of these queries is
C<http://server/S3qL.php?query=XMLFORMAT>.  Here C<XMLFORMAT> stands
in for the precise specification of the query, which is written in a
simplified form of XML.

In order to build these queries conveniently in perl, we have borrowed
the AUTOLOAD implementation from Lincoln Stein's CGI package.  Each
legal tag in the S3DB language is implemented (via AUTOLOAD) as a
method that wraps the arguments to the function in the appropriate
tag.  This the smaple code given in the synopsis produces a C<select>
API call, where C<$stuff> is the regular expression to be matched,
C<$table> is the name of the S3DB table from which the data should be
selected, and C<%where> is a hash containing the selection criteria.

Valid query types are C<select>, C<insert>, C<edit>, and C<delete>.
Currently, the S3DB tables that can be queried using C<select> are:
C<projects>, C<rules>, C<classes>, C<instances>, C<statements>,
C<users>, C<groups>, and C<keys>.  Valid fields and the correct XML
format for all types of queries are documented at the S3DB web site.

=cut

## private default values, mainly for testing
## public methods should require these to be set properly.
my $host = 'http://ibl.mdanderson.org/s3db/';
my $main = 'S3QL.php';
my $upload = 'uploads.php';
my $format = 'tab';

%MY_TAGS = (
	    ':s3ql' => [qw/S3QL key from where format notes created_on created_by
			set confirm select insert delete edit/],
	    ':project' => [qw/project_id project_name project_description project_owner /],
	    ':rules' => [qw/rule_id subject verb object project_id permission/],
	    ':classes' => [qw/class_id resource_id entity project_id/],
	    ':instances' => [qw/instance_id resource_id resource_class_id entity project_id class_id/],
	    ':statements' => [qw/statement_id resource_id rule_id entity file_name project_id value/],
	    ':users' => [qw/account_id account_uname account_email account_phone/],
	    ':keys' => [qw/key_id account_id expires filekey/],
	    ':all' => [qw/:s3ql :project :rules :classes :instances :statements :users :keys/]
	    );

@MY_SYMS = ();
foreach my $k (keys %MY_TAGS) {
    my $a = $MY_TAGS{$k};
    push @MY_SYMS, @$a;
}

# This is the default class for the S3QL object to use when all else fails.
$DefaultClass = 'S3QL::Raw' unless defined $S3QL::Raw::DefaultClass;

# This is where to look for autoloaded routines.
$AutoloadClass = $DefaultClass unless defined $S3QL::Raw::AutoloadClass;

=head1 Keys

An S3DB key, valid for the database accessible through the web host,
must be supplied in order to construct a C<S3QL::Raw> object. See the
instructions at L<http://www.s3db.org> to learn how to obtain a key
using the web interface.

=cut

sub new {
    my ($class, $initializer) = @_;
    my $self = {};
    bless $self, ref $class || $class;
    $self->init($initializer);
    return $self;
}

sub startFileUpload {
    my ($self, $filename, $filesize) = @_;
    croak "No filename to upload!" unless $filename;
    my $k = $self->{'my_key'};
    my $furl = "$self->{'my_host'}$upload";
    my $query = "$furl?key=$k&filename=$filename";
    $query .= "&filesize=$filesize" if $filesize;
    return $query;
}

sub midFileUpload { 
    my ($self, $key, $frag, $encode) = @_;
    my $query = "filekey=$key&fragNr=$frag";
    if ($encode) {
	$query .= "&encode=$encode";
    }
    my $furl = "$self->{'my_host'}$upload";
    my @val = ($furl, $query);
    return @val;
}

sub query {
    my $self = shift;
    my $k = $self->key($self->{'my_key'});
    my $f = $self->format($self->{'my_format'});
    my $q = $self->{'my_query'};
    my $que = $self->S3QL($k . $q . $f);
    my $url = "$self->{'my_host'}$main";
    return "$url?query=$que";
}

sub expand_tags {
    my($tag) = @_;
    return ("start_$1","end_$1") if $tag=~/^(?:\*|start_|end_)(.+)/;
    my(@r);
    return ($tag) unless $MY_TAGS{$tag};
    foreach (@{$MY_TAGS{$tag}}) {
	push(@r,&expand_tags($_));
    }
    return @r;
}



#### Method: DESTROY
# We provide a DESTROY method so that the autoloader
# doesn't bother trying to find it.
sub DESTROY { }

#### Method: init
sub init {
    my ($self, $init) = @_;
    $self->{my_query} = '';
    if ($init && ref($init) && ref($init) eq 'HASH') {
	foreach my $k (keys %$init) {
	    $self->{$k} = $init->{$k}
	}
    }
    $self->{'my_host'} = $host unless defined($self->{'my_host'});
    my $temp = $self->{'my_host'};
    $temp = "http://$temp" unless $temp =~ /^http/;
    $temp = "$temp/" unless $temp =~ /\/$/;
    $self->{'my_host'} = $temp;
    die "You must supply a value for 'my_key'!" unless defined($self->{'my_key'});
    $self->{'my_format'} = $format unless defined($self->{'my_format'});
}

## borrowed from GCI::Utils
sub make_attr {
    my $attr = shift;
    return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
    my $escape = shift || 0;
    my(@att);
    foreach (keys %{$attr}) {
	my($key) = $_;
	$key=~s/^\-//;     # get rid of initial - if present
	$key=~tr/A-Z_/a-z-/; # parameters are lower case, use dashes
	my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_};
	push(@att,defined($attr->{$_}) ? qq/$key="$value"/ : qq/$key/);
    }
    return @att;
}

## borrowed from CGI
sub make_tags {
    my ($self, $tagname) = @_;
    my $func = qq(
	sub $tagname {
            shift if \$_[0] && 
		(ref(\$_[0]) &&
		 (substr(ref(\$_[0]),0,3) eq 'S3QL::Raw' ||
		  UNIVERSAL::isa(\$_[0],'S3QL::Raw')));
	    my(\$attr) = '';
	    if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') {
		my(\@attr) = make_attr(shift()||undef,1);
		\$attr = " \@attr" if \@attr;
	    }
	    my(\$tag,\$untag) = ("\L<$tagname\E\$attr>","\L</$tagname>\E");
	    my \@result = map { "\$tag\$_\$untag" } 
	                 (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
	    return "\@result";
	});
    return $func;
}

## borrowed from CGI
sub AUTOLOAD {
    my $func = &_comp;
    goto &$func;
}

## borrowed from CGI
sub _comp {
    my($func) = $AUTOLOAD;
    my($pack,$func_name);
    {
	local($1,$2); # this fixes an obscure variable suicide problem.
	$func=~/(.+)::([^:]+)$/;
	($pack,$func_name) = ($1,$2);
	$pack=~s/::SUPER$//;	# fix another obscure problem
	$pack = ${"$pack\:\:AutoloadClass"} || $S3QL::Raw::DefaultClass
	    unless defined(${"$pack\:\:AUTOLOADED_ROUTINES"});

        my($sub) = \%{"$pack\:\:SUBS"};
        unless (%$sub) {
	   my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"};
	   eval "package $pack; $$auto";
	   croak("$AUTOLOAD: $@") if $@;
           $$auto = '';  # Free the unneeded storage (but don't undef it!!!)
       }
       my($code) = $sub->{$func_name};

       $code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY');
       if (!$code) {
	   (my $base = $func_name) =~ s/^(start_|end_)//i;
	   if ($EXPORT{':any'} || 
	       $EXPORT{'-any'} ||
	       $EXPORT{$base} || 
	       (%MY_SYMS || grep(++$MY_SYMS{$_},&expand_tags(':all')))
	           && $MY_SYMS{$base}) {
	       $code = $S3QL::Raw::DefaultClass->make_tags($func_name);
	   }
       }
       croak("Undefined subroutine $AUTOLOAD\n") unless $code;
       eval "package $pack; $code";
       if ($@) {
	   $@ =~ s/ at .*\n//;
	   croak("$AUTOLOAD: $@");
       }
    }       
    CORE::delete($sub->{$func_name});  #free storage
    return "$pack\:\:$func_name";
}

$AUTOLOADED_ROUTINES = '';      # get rid of -w warning
$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';

%SUBS = (
#### Method: version
# Return the current version
####
'version' => <<'END_OF_FUNC',
sub version {
    return $VERSION;
}
END_OF_FUNC

'_comp_all' => <<'END_OF_FUNC',
sub _comp_all {
    foreach (@_) {
	next if defined(&$_);
	$AUTOLOAD = "S3QL::Raw::$_";
	_comp();
    }
}
END_OF_FUNC

);
END_OF_AUTOLOAD
;

return 1; # like a good module should

__END__


=head1 SEE ALSO

Most of the time, you will want to use the higher-level interface
provided by the L<S3QL> package.

=cut

